home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 37 / Amiga Format CD37 (1999-02-16)(Future Publishing)(GB)(Track 1 of 3)[!][issue 1999-03].iso / -screenplay- / otherstuff / petro / petro.asc < prev    next >
Text File  |  1999-01-04  |  5KB  |  159 lines
  1. ; Petro - public domain by James L Boyd
  2. ; do what you like with it ;)
  3.  
  4. ; IMPORTANT - type Blitzlibs:amigalibs.res into the Resident box
  5. ; in Compiler Options
  6.  
  7. ; note the distribution version of the executable is packed
  8. ; with StoneCracker (recommended :)
  9.  
  10. ; don't forget to turn the Debugger off when you make the executable
  11.  
  12. v$="$VER: Petro 1.0 (20-9-1998) James L Boyd"
  13. ; version number (appears in WBVersion,etc)
  14.  
  15. WBStartup ; start from a Workbench icon
  16. FindScreen 0,"Workbench Screen" ; find the WB screen
  17. NoCli ; no default cli
  18.  
  19. x.w=0 ; default window position
  20. y.w=0 ;        ditto
  21. offset.b=4 ; default for weird shape positioning
  22.  
  23. If GetIconObject("progdir:Petro") ; read icon's tooltypes
  24. title$=FindToolValue("TITLE")
  25. gadgettext$=FindToolValue("GADGET_TEXT")
  26. petrogfx$=FindToolValue("PETRO_GFX") ; "petro_gfx.iff"
  27. petrosnd$=FindToolValue("PETRO_SND") ; "petro_snd.iff"
  28. x=Val(FindToolValue("X"))
  29. y=Val(FindToolValue("Y"))
  30. offset=Val(FindToolValue("OFFSET"))
  31. FreeIconObject ; IMPORTANT! free the icon
  32. EndIf
  33.  
  34. ;set defaults in case of tooltype errors
  35. If title$="" Then title$="Petro"
  36. If gadgettext$="" Then gadgettext$="Talk to me!"
  37. If petrogfx$="" OR Exists(petrogfx$)=0 Then petrogfx$="progdir:snd+gfx/petro_gfx.iff"
  38. If petrosnd$="" OR Exists(petrosnd$)=0 Then petrosnd$="progdir:snd+gfx/petro_snd.iff"
  39.  
  40. #SIGBREAKF_CTRL_C=1 ASL 12 ; to enable trapping of CTRL-C messages later
  41.  
  42. ;get some info (used to get WB font height) - don't understand this ;)
  43.  
  44. *SC.Screen=Peek.l(Addr Screen(0))
  45. *SCFONT.TextAttr=*SC.Screen\Font
  46. *USEDFONT.TextAttr=*SCFONT.TextAttr
  47. HEIGHT_WBFONT=(*SCFONT.TextAttr\ta_YSize)
  48.  
  49. ; gadtools menus (automatic spacing,etc)
  50.  
  51. GTMenuTitle 0,0,"Project"
  52. GTMenuItem 0,0,0,0,"Snapshot window","S"
  53. GTMenuItem 0,0,0,1,"About","A"
  54. GTMenuItem 0,0,0,2,"Quit","Q"
  55.  
  56. ; check the files are there
  57. If Exists(petrogfx$)=0 OR Exists(petrosnd$)=0
  58. ;Request "","INFO : "+petrogfx$+"+"+petrosnd$,"OK"
  59.   Request "Petro","ERROR - Can't find Petro's files...","Oh...":Goto quit
  60. EndIf
  61.  
  62. ; error trap if wrong type of file,or something weird happens ;)
  63.  
  64. ; start of error trapping code
  65. SetErr ; do whatever's between here and End SetErr if an error occurs...
  66. Request "Petro","Ooh,bad error - quitting!||Try checking your tooltypes and sound/graphics files!","Uh,right...":End
  67. End SetErr
  68.  
  69. LoadShape 0,petrogfx$
  70. LoadSound 0,petrosnd$
  71.  
  72. ClrErr
  73. ;end of error trapping code (so it includes the loadshape/sound part)
  74.  
  75. ; about requester string
  76. req$="P e t r o||This is Petro Tyschtschenko,|President of Amiga International...||All Hail Petro!"
  77. req$=req$+"||Written by a bored James L Boyd,|19 September 1998 ;)"
  78. req$=Replace$(req$,"|",Chr$(10)) ; replace |'s with chr$(10) for RTEZRequest (normal Request uses |'s)
  79.  
  80. tryagain ; program loops back here if window fails to open
  81.  
  82. If tried.b<2 ; if window failed to open
  83.  
  84.   If tried=1 ; if failed once
  85.     Request "Petro","Window wouldn't fit on screen!|Resetting to X=0 and Y=0,and updating tooltypes!","Right..."
  86.     x=0:y=0:Gosub snap
  87.   EndIf
  88.  
  89.   If Window (0,x,y,ShapeWidth(0)+offset+8,HEIGHT_WBFONT+ShapeHeight(0)+28,$e,title$,1,2)=0 Then tried+1:Goto tryagain
  90.  
  91. Else Request "Petro","Can't open window - low chip memory?","Abort":Goto quit ; if window didn't open on second try
  92. EndIf
  93.  
  94. GTButton 0,51,2,ShapeHeight(0)+2,ShapeWidth(0),20,gadgettext$,0 ; the gadget
  95.  
  96. AttachGTList 0,0 ; attach the gadget list to the window
  97. GTSetMenu 0 ; and the menus
  98.  
  99. WBlit 0,WLeftOff+2,HEIGHT_WBFONT+4 ; blit the shape
  100.  
  101. loop ; main event loop
  102.  
  103. ev.l=Event ; get window event
  104. VWait 5 ; delay to aid multitasking (don't need a rapid response here ;)
  105.  
  106. ; check for CTRL-C message
  107. If (SetSignal_(0,#SIGBREAKF_CTRL_C) & #SIGBREAKF_CTRL_C) ; catch CTRL-C's
  108.   Goto quit
  109. EndIf
  110.  
  111. Select ev ; find value of ev
  112.  
  113. Case $40 ; gadget hit
  114.  
  115.   Sound 0,10 ; speak,Petro!
  116.   Freq 10,127 ; - damn sound sample kept playing slow,so had to speed it up!
  117.  
  118. Case $100 ; menu hit
  119.   Select ItemHit ; find the menu item
  120.     Case $0 ; snapshot
  121.       x=WindowX:y=WindowY
  122.       Gosub snap
  123.     Case $1 ; about
  124.       lock.l=RTLockWindow(0)
  125.       rt.l=RTEZRequest ("Petro",req$,"Cool...")
  126.       RTUnlockWindow 0,lock
  127.     Case $2 ; quit
  128.       Goto quit
  129.   End Select
  130.  
  131. Case $200 ; close gadget
  132.   Goto quit
  133.  
  134. End Select ; end of main Select WaitEvent loop
  135.  
  136. Goto loop ; end of whole event loop
  137.  
  138. snap ; snapshot window
  139. If GetIconObject("progdir:Petro") ; write tooltypes
  140. ClearToolTypes ; clear the ones that are there
  141. ; and stick all the values back in
  142. NewToolType "DONOTWAIT",""
  143. NewToolType "TITLE",title$
  144. NewToolType "GADGET_TEXT",gadgettext$
  145. NewToolType "PETRO_GFX",petrogfx$
  146. NewToolType "PETRO_SND",petrosnd$
  147. NewToolType "X",Str$(x)
  148. NewToolType "Y",Str$(y)
  149. NewToolType "OFFSET",Str$(offset)
  150. PutIconObject ("progdir:Petro") ; WRITE the icon (important!)
  151. FreeIconObject ; free the icon (important!)
  152. Else Request "Petro","Error saving tooltypes","Weird..." ; didn't work
  153. EndIf
  154.  
  155. Return
  156.  
  157. quit
  158. End
  159.